home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / ANC_UTULITYS_16.adf / Check.arc / Checkers (.txt) next >
AmigaBASIC Source Code  |  1988-09-21  |  8KB  |  253 lines
  1. SAY TRANSLATE$("")
  2. SCREEN 2,640,200,3,2
  3. WINDOW 2,"",,0,2
  4. GOSUB MakeScreen
  5. Start:g=-1:R(0)=-99:NP=12
  6. DATA 1,0,1,0,0,0,-1,0,0,1,0,0,0,-1,0,-1,15
  7. FOR x=7 TO 0 STEP -1:FOR y=0 TO 7:READ J:IF J=15 THEN 10
  8. s(x,y)=J:GOTO 20
  9. 10 RESTORE:READ s(x,y)
  10. 20 NEXT y,x
  11. 30 FOR x=7 TO 0 STEP -1:FOR y=0 TO 7:IF s(x,y)>-1 THEN 40
  12. IF s(x,y)=-1 THEN
  13. FOR a=-1 TO 1 STEP 2
  14. b=g:GOSUB 50
  15. NEXT a
  16. END IF
  17. IF s(x,y)=-2 THEN
  18. FOR a=-1 TO 1 STEP 2
  19. FOR b=-1 TO 1 STEP 2
  20. GOSUB 50
  21. NEXT b,a
  22. END IF
  23. 40 NEXT y,x:GOTO 90
  24. 50 u=x+a:v=y+b:IF u<0 OR u>7 OR v<0 OR v>7 THEN 60
  25. IF s(u,v)=0 THEN GOSUB 70:GOTO 60
  26. IF s(u,v)<0 THEN 60
  27. u=u+a:v=v+b:IF u<0 OR v<0 OR u>7 OR v>7 THEN 60
  28. IF s(u,v)=0 THEN GOSUB 70
  29. 60 RETURN                                         
  30. 70 IF v=0 AND s(x,y)=-1 THEN q=q+2                 
  31. IF ABS(y-v)=2 THEN q=q+5
  32. IF y=7 THEN q=q-2
  33. IF y=0 OR u=7 THEN q=q+1
  34. FOR c=-1 TO 1 STEP 2:IF u+c<0 OR u+c>7 OR v+g<0 THEN 80
  35. IF s(u+c,v+g)<0 THEN q=q+1:GOTO 80
  36. IF u-c<0 OR u-c>7 OR v-g>7 THEN 80
  37. IF s(u+c,v+g)>0 AND (s(u-c,v-g)=0 OR (u-c=x AND v-g=y)) THEN q=q-2
  38. 80 NEXT c:IF q>R(0) THEN R(0)=q:R(1)=x:R(2)=y:R(3)=u:R(4)=v      
  39. q=0:RETURN
  40. 90 IF R(0)=-99 THEN 260                       'You Win 
  41. R(0)=-99
  42. 100 IF R(4)=0 THEN s(R(3),R(4))=-2:GOTO 110   'King Computers Piece 
  43. Count=Count+1:IF Count=1 THEN GOSUB PlaceCheckers
  44. IF s(R(1),R(2))=-1 AND R(2)<R(4) THEN 150     'stops illegal double jump
  45. s(R(3),R(4))=s(R(1),R(2))
  46. 110 s(R(1),R(2))=0                    'clears where computer just moved from 
  47. e=R(1):h=R(2):a=R(3):b=R(4)
  48. IF ABS(R(1)-R(3))<>2 THEN cc=-1:rr=-1:GOSUB move:GOTO 150
  49. cc=(R(1)+R(3))/2:rr=(R(2)+R(4))/2
  50. s(cc,rr)=0:GOSUB move                          'clears spot jumped
  51. x=R(3):y=R(4):IF s(x,y)=-1 THEN b=-2:FOR a=-2 TO 2 STEP 4:GOSUB 130
  52. IF s(x,y)=-2 THEN 120
  53. NEXT a:IF R(0)<>-99 THEN R(0)=-99:GOTO 100
  54. 120 FOR a=-2 TO 2 STEP 4:FOR b=-2 TO 2 STEP 4:GOSUB 130:NEXT b   
  55. NEXT a:IF R(0)<>-99 THEN R(0)=-99:GOTO 100
  56. GOTO 150
  57. 130 u=x+a:v=y+b:IF u<0 OR u>7 OR v<0 OR v>7 THEN 140   
  58. IF s(u,v)=0 AND s(x+a/2,y+b/2)>0 THEN GOSUB 70
  59. 140 RETURN    
  60. 150 LOCATE 1,1:PRINT SPACE$(80):LOCATE 1,1:PRINT "From ";    
  61. 160 IF MOUSE(0)<>0 THEN 160                                
  62. 170 q$=INKEY$:IF q$=CHR$(139) THEN Help                     
  63. IF MOUSE(0)=0 THEN 170
  64. col=MOUSE(1):row=MOUSE(2):GOSUB Calc
  65. IF col<0 OR col>7 OR row<0 OR row>7 THEN 150
  66. PRINT col;" ";row:e=col:h=row
  67. IF e<0 OR h<0 THEN BEEP:GOTO 150
  68. x=e:y=h:IF s(x,y)<=0 THEN BEEP:GOTO 150
  69. 180 LOCATE 1,30:PRINT SPACE$(15):LOCATE 1,30:PRINT "To ";      
  70. IF MOUSE(0)=-1 THEN
  71. 185 IF MOUSE(0)=0 THEN 205 :ELSE 185
  72. END IF
  73. 190 IF MOUSE(0)<>0 THEN 190                 
  74. 200 q$=INKEY$:IF q$=CHR$(139) THEN Help   
  75. IF MOUSE(0)=0 THEN 200
  76. 205 col=MOUSE(1):row=MOUSE(2):GOSUB Calc
  77. IF col<0 OR col>7 OR row<0 OR row>7 THEN BEEP:GOTO 150
  78. IF s(x,y)=1 AND row<h THEN
  79. BEEP:FOR i=1 TO 100:NEXT i
  80. SAY TRANSLATE$("cheater cheater cheater.")
  81. GOTO 180
  82. END IF
  83. PRINT col;" ";row
  84. a=col:b=row:x=a:y=b
  85. IF s(x,y)=0 AND ABS(a-e)<=2 AND ABS(a-e)=ABS(b-h) THEN 210
  86. GOTO 180
  87. 210 olds=s(a,b):s(a,b)=s(e,h):s(e,h)=0           'clears where person was
  88. IF ABS(e-a)<>2 THEN cc=-1:rr=-1:GOSUB move:GOTO 250
  89. cc=(e+a)/2:rr=(h+b)/2
  90. IF s(cc,rr)=1 OR s(cc,rr)=2 THEN
  91. SAY TRANSLATE$("You cannot jump over yourself.")
  92. s(e,h)=s(a,b):s(a,b)=olds:GOTO 150
  93. END IF
  94. s(cc,rr)=0:GOSUB move                    'clears spot jumped by person
  95. 220 LOCATE 1,1:PRINT SPACE$(80):LOCATE 1,1               
  96. PRINT "Click again in the same place to end your move."
  97. LOCATE 1,60:PRINT "+To";:SAY TRANSLATE$("and")
  98. 230 IF MOUSE(0)<>0 THEN 230                  
  99. 240 q$=INKEY$:IF q$=CHR$(139) THEN Help     
  100. IF MOUSE(0)=0 THEN 240
  101. col=MOUSE(1):row=MOUSE(2):GOSUB Calc
  102. IF s(x,y)=1 AND row<b AND POINT(col,row)<>0 THEN BEEP:SAY TRANSLATE$("cheater cheater cheater."):GOTO 220
  103. PRINT col;" ";row:a1=col:b1=row
  104. IF (a1=a AND b1=b) OR col<0 OR col>7 OR row<0 OR row>7 THEN 250
  105. IF s(a1,b1)<>0 OR ABS(a1-a)<>2 OR ABS(b1-b)<>2 THEN 220
  106. e=a:h=b:a=a1:b=b1
  107. GOTO 210
  108. 250 IF b=7 THEN s(a,b)=2                 
  109. GOTO 30
  110. 260 PRINT "You Win!":SAY TRANSLATE$("You Win!")     
  111. GOTO PlayAgain
  112. ComputerWins:GOSUB move
  113. PRINT "I Win this Game!":SAY TRANSLATE$("I win this game!")
  114. PlayAgain:
  115. SAY TRANSLATE$("How about another?")
  116. PRINT:PRINT "(Y/N)"
  117. 270 a$=UCASE$(INKEY$):IF a$="" OR (a$<>"Y" AND a$<>"N") THEN 270
  118. IF a$="Y" THEN GOSUB Draw:Count=0:GOTO Start :ELSE SAY TRANSLATE$("by by."):SYSTEM
  119. move:
  120. ee=e*50+160
  121. hh=(-h+7)*20+31
  122. aa=a*50+160
  123. bb=(-b+7)*20+31
  124. LINE(ee-24,hh-9)-(ee+24,hh+9),5,bf
  125. IF s(a,b)=1 THEN PUT(aa-12,bb-5),yellow,PSET
  126. IF s(a,b)=2 OR b=7 THEN PUT(aa-12,bb-5),yking,PSET
  127. IF s(a,b)=-1 THEN
  128. PUT(aa-12,bb-5),red,PSET
  129. IF cc>-1 AND rr>-1 THEN NP=NP-1:IF NP=0 THEN ComputerWins
  130. END IF
  131. SOUND 10000,0.05
  132. IF s(a,b)=-2 THEN
  133. PUT(aa-12,bb-5),rking,PSET
  134. IF cc>-1 AND rr>-1 THEN NP=NP-1:IF NP=0 THEN ComputerWins
  135. END IF
  136. IF cc>-1 AND rr>-1 THEN
  137. ccc=cc*50+160
  138. rrr=(-rr+7)*20+31
  139. LINE(ccc-24,rrr-9)-(ccc+24,rrr+9),5,bf
  140. END IF
  141. RETURN
  142. PlaceCheckers:
  143. FOR z=0 TO 7
  144. FOR x=0 TO 7
  145. y=-z+7
  146. xx=x*50+160
  147. yy=y*20+31
  148. IF s(x,-y+7)=1 THEN PUT(xx-12,yy-5),yellow,PSET
  149. IF s(x,-y+7)=-1 THEN PUT(xx-12,yy-5),red,PSET
  150. NEXT x,z
  151. RETURN
  152. Help:
  153. SAY TRANSLATE$("if you are really stuck - press Y.")
  154. 280 a$=UCASE$(INKEY$):IF a$="" THEN 280
  155. IF a$="Y" THEN PRINT:GOTO ComputerWins
  156. SAY TRANSLATE$("o.k."):GOTO 150
  157. Calc:
  158. IF col>135 AND col<185 THEN col=0
  159. IF col>185 AND col<235 THEN col=1
  160. IF col>235 AND col<285 THEN col=2
  161. IF col>285 AND col<335 THEN col=3
  162. IF col>335 AND col<385 THEN col=4
  163. IF col>385 AND col<435 THEN col=5
  164. IF col>435 AND col<485 THEN col=6
  165. IF col>485 AND col<535 THEN col=7
  166. IF row>21 AND row<41 THEN row=7
  167. IF row>41 AND row<61 THEN row=6
  168. IF row>61 AND row<81 THEN row=5
  169. IF row>81 AND row<101 THEN row=4
  170. IF row>101 AND row<121 THEN row=3
  171. IF row>121 AND row<141 THEN row=2
  172. IF row>141 AND row<161 THEN row=1
  173. IF row>161 AND row<181 THEN row=0
  174. RETURN
  175. MakeScreen:
  176. PALETTE 2,0.8,0,0         'red
  177. LOCATE 2,36:PRINT "Checkers"
  178. PRINT TAB(39);"by"
  179. PRINT TAB(35);"Steve Carr"
  180. LOCATE 7,3:PRINT "TO move - click the piece you want to move and then click on the spot"
  181. PRINT TAB(13);"where you want it"
  182. PRINT TAB(8);"Or - click the piece you want to move, hold the button down,"
  183. PRINT TAB(13);"and let go of it over the spot you want the checker"
  184. LOCATE 15,9:PRINT "If at any time you absolutely can't make a move Press HELP"
  185. LOCATE 17,6:PRINT "TO cancel a move after choosing (from) - click in the brown area"
  186. LOCATE 20,24:PRINT "Do you want to be red or yellow?"
  187. COLOR 2,1:LOCATE 22,34:PRINT " Press R OR Y ";
  188. 290 c$=UCASE$(INKEY$):IF c$="" OR (c$<>"R" AND c$<>"Y") THEN 290
  189. DIM yellow(44),red(44),yking(44),rking(44),R(4),s(7,7)
  190. PALETTE 0,0.6,0.33,0       'brown
  191. PALETTE 1,0.6,0.33,0       'brown
  192. PALETTE 3,0.87,0.8,0.4      'yellow
  193. PALETTE 4,1,0.4,0         'orange
  194. PALETTE 5,0.27,0.27,0.27    'dark grey
  195. PALETTE 6,0.8,0.8,0.8       'light grey
  196. PALETTE 7,0,0,0          'black
  197. COLOR 7,5:CLS
  198. CIRCLE(162,32),14,7
  199. PAINT (162,32),7,7
  200. CIRCLE (160,31),14,2
  201. PAINT (160,31),4,2
  202. CIRCLE (160,31),14,7
  203. CIRCLE (160,31),9,7
  204. PAINT (160,31),3,7
  205. GET(146,25)-(176,38),yellow
  206. PAINT(160,31),2,7
  207. GET(146,25)-(176,38),red
  208. COLOR 7,5:CLS
  209. PUT(146,21),red,PSET
  210. COLOR 7,2:LOCATE 4,1
  211. PRINT PTAB(157);"K"
  212. CIRCLE(160,27),9,7
  213. GET(146,21)-(176,34),rking
  214. COLOR 7,5:CLS
  215. PUT(146,21),yellow,PSET
  216. COLOR 7,3: LOCATE 4,1
  217. PRINT PTAB(157);"K"
  218. CIRCLE(160,27),9,7
  219. GET(146,21)-(176,34),yking
  220. Draw:COLOR 1,0:CLS
  221. LINE(136,22)-(534,180),6,bf
  222. FOR i=21 TO 181 STEP 20
  223. LINE(135,i)-(535,i),7
  224. NEXT i
  225. FOR i=135 TO 535 STEP 50
  226. LINE(i,21)-(i,181),7
  227. NEXT i
  228. LINE(134,21)-(134,181),7
  229. LINE(535,21)-(551,26),7
  230. LINE -(551,186),7
  231. LINE -(148,186),7
  232. LINE -(135,181),7
  233. PAINT(549,30),7,7
  234. FOR J=31 TO 151 STEP 40
  235. FOR i=160 TO 460 STEP 100
  236. LINE(i-24,J-9)-(i+24,J+9),5,bf
  237. NEXT i,J
  238. FOR J=51 TO 171 STEP 40
  239. FOR i=210 TO 510 STEP 100
  240. LINE(i-24,J-9)-(i+24,J+9),5,bf
  241. NEXT i,J:COLOR 7,0
  242. IF c$="R" THEN
  243. Game=Game+1
  244. IF Game=1 THEN 
  245. FOR i=0 TO 44
  246. SWAP red(i),yellow(i)
  247. SWAP rking(i),yking(i)
  248. NEXT i
  249. END IF
  250. END IF
  251. RETURN
  252.  
  253.